home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / top_src.arj / TOPDROP.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-11-05  |  2.5 KB  |  132 lines
  1. defint a-z
  2.  
  3. declare function pdqvali(st$)
  4. declare sub delstr alias "b$stdl" (work$)
  5.  
  6. dim users$(1 to 5000)
  7. dim down(1 to 5000)
  8.  
  9. cu=5000
  10.  
  11. print "TOPDROP 1.00   Copyright 1993 NUIQ SOFTWARE INC   All Rights Reserved"
  12. print "Powerboard BBS Top Carrier Dropper List Creator"
  13. print
  14.  
  15. a$=dir$("logs\callers.*")
  16. return$=chr$(13)
  17.  
  18. do while len(a$)
  19.   print space$(79);return$;
  20.   print "Reading LOGS\"a$
  21.   open "logs\"+a$ for input shared as 1
  22.     cl=0
  23.     do until eof(1)
  24.     cl=cl+1
  25.     if cl mod 100=0 then print "Line "str$(cl);"  ";return$;
  26.     line input #1, ln$
  27.     if left$(ln$,2)=">>" and instr(ln$,"Back")=0 then
  28. '      d=instr(26,ln$,"User")
  29. d=-1
  30.       if d then
  31.         d=instr(23,ln$,":")
  32.         ad=instr(d+1,ln$,":")
  33.         if ad then d=ad
  34.         if d then
  35.           t$=mid$(ln$,d+2)
  36.           d=instr(t$,"Logged On")
  37.           t$=ltrim$(left$(t$,d-2))
  38.           for cu=1 to usrs
  39.             if users$(cu)=t$ then goto dl0
  40.           next
  41.           usrs=usrs+1
  42.           cu=usrs
  43.           users$(cu)=t$
  44.         end if
  45.       end if
  46.     end if
  47.     d=instr(26,ln$," ")
  48.     if d then
  49.       if mid$(ln$,26)="Carrier lost." then
  50.         down(cu)=down(cu)+1
  51.       end if
  52.     end if
  53. dl0:
  54.   loop
  55.   close 1
  56. a$=dir$
  57. loop
  58. print
  59. print "Sorting . . . ";
  60.  
  61. x=0
  62. do until x=>usrs
  63. x=x+1
  64.   if down(x)=0 then
  65.     for d=1 to usrs
  66.       if down(d) then
  67.         down(x)=down(d)
  68.         users$(x)=users$(d)
  69.         delstr users$(d)
  70.         down(d)=0
  71.         goto dl
  72.       end if
  73.     next
  74.     delstr users$(x)
  75.     down(x)=0
  76.   end if
  77. dl:
  78. loop
  79.  
  80. x=0
  81. do until x=>usrs
  82. x=x+1
  83.   if down(x)=0 then
  84.     for y=usrs to 1 step -1
  85.       if y>x then
  86.         if down(y) then
  87.           users$(x)=users$(y)
  88.           down(x)=down(y)
  89.           down(y)=0
  90.           delstr users$(y)
  91.           if y=usrs then usrs=usrs-1
  92.           exit for
  93.         end if
  94.       end if
  95.     next
  96.   end if
  97. loop
  98.  
  99. for x=1 to usrs
  100.   if down(x)=0 then usrs=x-1:exit for
  101. next
  102.  
  103. do
  104.   outoforder=0
  105.   for x=1 to usrs-1
  106.     if down(x)<down(x+1) then
  107.       swap down(x), down(x+1)
  108.       swap users$(x), users$(x+1)
  109.       outoforder=-1
  110.     end if
  111.   next
  112. loop while outoforder
  113.  
  114. print "Done!"
  115.  
  116. print
  117.  
  118. c$=command$
  119. a=pdqvali(c$)
  120. if a<1 then a=20
  121. open "topdrop.asc" for output as 2
  122. print #2, "TOPDROP 1.00   Copyright 1993 NUIQ SOFTWARE INC   All Rights Reserved"
  123. print #2, ""
  124. for x=1 to usrs
  125.   if x>a then exit for
  126.   print #2, left$(users$(x)+space$(30),30)" "down(x)
  127. next
  128. close 2
  129.  
  130. print "Top "str$(a)" carrier droppers written to TOPDROP.ASC."
  131. print
  132.